home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / sbin / update-mime < prev    next >
Text File  |  2009-09-09  |  6KB  |  254 lines
  1. #! /usr/bin/perl
  2. ###############################################################################
  3. #
  4. #  Update-MIME:  Install programs into "/etc/mailcap", resolve conflicts,
  5. #                 auto-uninstall, make dinner, and wash dishes.
  6. #
  7. #  Written by Brian White <bcwhite@pobox.com>.
  8. #
  9. #  This program has been placed in the public domain (the only true "free").
  10. #  Do whatever you wish with it, though I'd appreciate it if my name stayed
  11. #  on it as the original author.
  12. #
  13. ###############################################################################
  14.  
  15. umask(022);
  16.  
  17.  
  18.  
  19. #
  20. # Program Constants
  21. #
  22. $debug        = 0;
  23. $conffile    = "/etc/update-mime.conf";
  24. $mailcap    = "/etc/mailcap";
  25. $mailcapdef    = "/usr/lib/mime/mailcap";
  26. $mimedir    = "/usr/lib/mime/packages";
  27. $orderfile    = "/etc/mailcap.order";
  28. $defpriority= 5;
  29.  
  30.  
  31. #
  32. # Allow local customizations
  33. #
  34. do $conffile if -f $conffile;
  35.  
  36.  
  37. #
  38. # Global Variables
  39. #
  40. %entries;
  41. %packages;
  42. %priorities;
  43. @order;
  44.  
  45.  
  46.  
  47. sub ReadEntries
  48. {
  49.     my($pkg,$priority,$counter);
  50.  
  51.     $counter=1;
  52.  
  53. #    foreach $file (glob "$mimedir/*") {
  54.     foreach $file (map { glob $_.'/*' } split ':',$mimedir) {
  55.         next if ($file =~ m!(^|/)(\.|\#)|(\~)$!);
  56.         ($pkg) = ($file =~ m|/([^/]*)$|);
  57.         print STDERR "$pkg:\n" if $debug;
  58.  
  59.         if (!defined $packages{$pkg}) {
  60.             $packages{$pkg} = [];
  61.         }
  62.  
  63.         if (open(FILE,"<$file")) {
  64.             while (<FILE>) {
  65.                 chomp;
  66.                 next if m/^\s*$|^\s*\#/;
  67.                 if (m/priority\s*=\s*(\d+)\s*($|;)/i) {
  68.                     $priority=$1;
  69.                 } else {
  70.                     $priority=$defpriority;
  71.                 }
  72.                 if ($priority < 0 || $priority > 9) {
  73.                     print STDERR "Error: priority of $priority is out of range (0 <= pri <= 9)\n";
  74.                     print STDERR "       $_\n";
  75.                     $priority=$defpriority;
  76.                 }
  77.                 s/([^\s;]\s+)(?![\'\"])([^\s;]*)%s([^\s;]*)/$1'$2%s$3'/g;
  78.                 $entries{$counter} = $_;
  79.                 push @{$packages{$pkg}},$counter;
  80.                 push @{$priorities{$priority}},$counter;
  81.                 print STDERR "$counter: $_\n" if $debug;
  82.                 $counter++;
  83.             }
  84.             close(FILE);
  85.         } else {
  86.             print STDERR "Warning: could not open file '$file' -- $!\n";
  87.         }
  88.     }
  89. }
  90.  
  91.  
  92.  
  93. sub ReadOrder
  94. {
  95.     if (-e $orderfile) {
  96.         if (open(FILE,"<$orderfile")) {
  97.             while (<FILE>) {
  98.                 chomp;
  99.                 s/\s*\#.*$//;
  100.                 next if m/^\s*$/;
  101.                 push @order,$_;
  102.             }
  103.             close(FILE);
  104.         } else {
  105.             print STDERR "Warning: could not open file '$orderfile' -- $!\n";
  106.         }
  107.     }
  108. }
  109.  
  110.  
  111.  
  112. sub OrderEntries
  113. {
  114.     my(@entrylist,@orderlist,@templist,$priority,$entrycode,$ordercode);
  115.  
  116.     foreach $priority (sort {$b <=> $a} keys %priorities) {
  117.         print STDERR " - Priority $priority:" if $debug;
  118.         @templist = @{$priorities{$priority}};
  119.         @templist = sort {
  120.             $ae  = $entries{$a};
  121.             $ac  = 0;
  122.             $ac += 1 if $ae =~ m!^\S+/\*!;
  123.             $ac += 2 if $ae =~ m!^\*/!;
  124.             $be  = $entries{$b};
  125.             $bc  = 0;
  126.             $bc += 1 if $be =~ m!^\S+/\*!;
  127.             $bc += 2 if $be =~ m!^\*/!;
  128.             $ac <=> $bc;
  129.         } @templist;
  130.         foreach $entry (@templist) {
  131.             print STDERR " $entry" if $debug;
  132.             push @entrylist,$entry;
  133.         }
  134.         print STDERR "\n" if $debug;
  135.     }
  136.  
  137.     print STDERR "entrylist: @entrylist\n" if $debug;
  138.     foreach $ordercode (@order) {
  139.         my($pkg,$typ);
  140.         if ($ordercode =~ m/:/) {
  141.             ($pkg,$typ) = ($ordercode =~ m/^(.*):(\S*)/);
  142.         } else {
  143.             $pkg = $ordercode;
  144.             $typ = "*/*";
  145.         }
  146.         $typ = "*/*" unless $typ;
  147.         print STDERR " - Ordering '$ordercode'...  (package=$pkg, type=$typ, orderlist=@orderlist)\n" if $debug;
  148.         $typ =~ s/\*/\.\*/g;
  149.         foreach $entrycode (@entrylist) {
  150.             next if grep(/^\Q$entrycode\E$/,@orderlist);
  151.             print STDERR "    - Checking entrycode '$entrycode' against (@{$packages{$pkg}})...\n" if $debug;
  152.             if (grep(/^\Q$entrycode\E$/,@{$packages{$pkg}})) {
  153.                 $entry = $entries{$entrycode};
  154.                 my($etype) = ($entry =~ m/^(.*?)(;|\s)/);
  155.                 print STDERR "       - entry found, type=$etype, checking against '$typ'\n" if $debug;
  156.                 if ($etype =~ m!^$typ$!) {
  157. #                    print STDERR "       - matched!\n" if $debug;
  158. #                    my($oaction) = ($ordercode =~ m/action=([^\s;]*)/i);
  159. #                    my($eaction) = ($entry     =~ m/action=([^\s;]*)/i);
  160. #                    $eaction="view" unless $eaction;
  161. #                    print STDERR "       - checking entry action '$eaction' against '$oaction'\n" if $debug;
  162. #                    if (!$oaction || $eaction =~ m/^($oaction)$/) {
  163.                         push @orderlist,$entrycode;
  164.                         print STDERR "       - matched!  (orderlist=@orderlist)\n" if $debug;
  165. #                    }
  166.                 }
  167.             }
  168.         }
  169.     }
  170.  
  171.     foreach $entrycode (@entrylist) {
  172.         next if grep(/^\Q$entrycode\E$/,@orderlist);
  173.         push @orderlist,$entrycode;
  174.     }
  175.  
  176.     print STDERR "orderlist: @orderlist\n" if $debug;
  177.     return @orderlist;
  178. }
  179.  
  180.  
  181.  
  182. #
  183. # Generate new mailcap file
  184. #
  185. sub UpdateMailcap
  186. {
  187.     my(@entrylist) = @_;
  188.     my(@above,@user,@below,$state,$entrycode);
  189.     $state = 0;
  190.     if (!open(PATH,"<$mailcap")) {
  191.         if (!open(PATH,"<$mailcapdef")) {
  192. #            print STDERR "Warning: could not read '$mailcap' (update stopped) -- $!\n";
  193. #            print STDERR "         restore from backup or delete and re-install mime-support package";
  194.             return;
  195.         }
  196.     }
  197.  
  198.     while (<PATH>) {
  199.         s/install-mime/update-mime/g;
  200.         if ($state == 0) {
  201.             push @above,$_;
  202.         }
  203.         $state=2 if ($state == 1 && /^\# ----- .* Ends /);
  204.         if ($state == 1) {
  205.             push @user,$_;
  206.         }
  207.         $state=1 if ($state == 0 && /^\# ----- .* Begins /);
  208.         if ($state == 2) {
  209.             push @below,$_;
  210.         }
  211.         $state=3 if ($state == 2);
  212.     }
  213.  
  214.     close PATH;
  215.  
  216.     if ($state == 3) {
  217.         my $newfile = join('',@above,@user,@below);
  218.         $newfile .= "\n###############################################################################\n\n";
  219.         foreach $entrycode (@entrylist) {
  220.             my $entry = $entries{$entrycode};
  221.             $entry =~ s/\s*priority\s*=\s*\d+\s*($|;)//;
  222.             $entry =~ s/\s*;\s*$//;
  223.             $newfile .= $entry."\n";
  224.         }
  225.  
  226.         if (!open(PATH,">$mailcap.new")) {
  227.             print STDERR "Error: could not write '$mailcap.new' -- $!\n";
  228.             exit(1) unless ($debug);
  229.             open(PATH,">-");
  230.         }
  231.         print PATH $newfile;
  232.         close PATH;
  233.         if (!open(PATH,"<$mailcap.new")) {
  234.             die "Error: could not read generated '$mailcap.new' -- $!\n";
  235.         }
  236.         my $savfile = "";
  237.         $savfile .= $_ while (<PATH>);
  238.         if ($savfile ne $newfile) {
  239.             die "Error: contents of '$mailcap.new' do not match what was written -- abort\n";
  240.         }
  241.         rename "$mailcap.new","$mailcap";
  242.     } else {
  243.         print STDERR "Error: '$mailcap' is not in required format -- not updated\n";
  244.         print STDERR "       Restore from backup or delete and re-install mime-support package";
  245.     }
  246. }
  247.  
  248.  
  249.  
  250. ReadEntries();
  251. ReadOrder();
  252. @list = OrderEntries();
  253. UpdateMailcap(@list);
  254.